home *** CD-ROM | disk | FTP | other *** search
/ Varios Español / Varios Español.iso / DBASE5 / SAMPLES.ZIP / PEDIDOS.PRG < prev    next >
Text File  |  1994-10-12  |  12KB  |  308 lines
  1.  
  2. ******************************************************************************
  3. * NOMBRE DEL PROGRAMA:             PEDIDOS.PRG
  4. *                                  PANTALLA DEL FICHERO DE ORDENES DE PEDIDOS
  5. *                                  PROGRAMA EJEMPLO DE APLICACION DE GESTION
  6. * ULTIMO CAMBIO:                   24/02/93 04:00 PM
  7. * ESCRITO POR:                     BORLAND
  8. ******************************************************************************
  9. *
  10. *       FICHEROS USADOS:
  11. *       Fichero de base de datos =  Pedidos.dbf
  12. *       Fichero de índice        =  Pedidos.mdx
  13. *        ETIQUETA: Pedido =  cod_cli+DTOS(fech_trans)+numero_pp <= Indice maestro
  14. *       Fichero de procedimientos externos  =  Libreria.prg
  15. ******************************************************************************
  16.  
  17. * Procedimiento principal
  18. PROCEDURE Pedidos
  19.  
  20.    * Enlazar con el fichero de procedimientos externos
  21.    SET PROCEDURE TO Librería
  22.  
  23.    * Definir entorno del fichero
  24.    DO Set_env
  25.    SET NEAR on
  26.    SET COLOR TO &c_standard.
  27.  
  28.    * Declaración de variables usadas:
  29.    * Variables de memoria para los campos de la base de datos
  30.    STORE "" TO Cód_cli, Núm_ped, Cód_emp, Cód_art
  31.    STORE {  /  /  } TO Fech_trans
  32.    Can_art = 0
  33.    Facturado = .F.
  34.  
  35.    * Variables diversas - usadas para pasar parámetros a Libreria
  36.    * para encontrar registros, obtener informes, listar registros y otras opciones
  37.    dbf   = "Pedidos"                  && Informe estándar disponible
  38.    mlist = "NO DISPONIBLE"            && Lista de correo no disponible
  39.    STORE "N/D" TO Cli_rpt             && Informe personalizado no disponible
  40.    key  = "m->Cód_cli+DTOC(m->Fech_trans)+m->Núm_ped"
  41.    key1 = "m->Cód_cli"
  42.    key2 = "m->Fech_trans"
  43.    key3 = "m->Núm_ped"
  44.    keyNomb1 = "Cliente Nº:"
  45.    keyNomb2 = "Fecha de Pedido:"
  46.    keyNomb3 = "Pedido Nº:"
  47.    list_flds = "Cód_cli,Fech_trans,Núm_ped,Cód_art,Can_art,Artículo->Precio"
  48.    STORE "" TO mCliid, mpartid, mempid
  49.  
  50.    * Abrir ficheros de base de datos y de índices
  51.    SELECT 1
  52.    USE Pedidos   ORDER Pedido
  53.    USE Artículo  ORDER Cód_art IN 2
  54.    USE Cli       ORDER Cód_cli IN 3
  55.    USE Empleado  ORDER Cód_emp  IN 4
  56.    SET RELATION TO Cód_art INTO Artículo, Cód_cli INTO Cli, Cód_emp INTO Empleado
  57.    GO TOP
  58.  
  59.    record_num = RECNO()
  60.    DO Load_fld
  61.  
  62.    * Visualizar la pantalla de datos
  63.    CLEAR
  64.    DO Dstatus
  65.    DO Backgrnd
  66.    DO Show_data
  67.  
  68.    * Definir menús de ventana
  69.    DO Bar_def
  70.  
  71.    * Activar el menú de ventana principal - ejecutar opción
  72.    SET COLOR TO &c_popup.
  73.    ACTIVATE POPUP main_mnu
  74.    DO Sub_ret
  75.    *
  76. RETURN
  77. *===========================fin del procedimiento principal==============================
  78.  
  79. *  PROCEDIMIENTOS DE UTILIDADES (Específicos de Pedidos.prg)
  80.  
  81. PROCEDURE Filter
  82.    * Agrupar datos por condición de filtro
  83.    * Seleccionar la condición de filtro (S=activar,N=cancelar,D=desactivar)
  84.    * Si el filtro está activado, la opción por defecto es S, visualizar ventana
  85.    * Si el filtro está desactivado, la opción por defecto es D, visualizar ventana
  86.    choice = IIF(filters_on,"D","S")
  87.    DO Filt_ans
  88.    IF choice = "S"
  89.       * Comenzar proceso de selección de la condición de filtro
  90.       *
  91.       mCliid     = SPACE(6)
  92.       mpartid    = SPACE(10)
  93.       mempid     = SPACE(11)
  94.       ACTIVATE WINDOW alert
  95.          * Obtener del usuario la condición de filtro
  96.          @  0, 0 SAY "--------- CONDICION DE FILTRO ---------"
  97.          @  2, 0 SAY "CLIENTE Nº.:" GET mCliid FUNCTION "!" ;
  98.             MESSAGE "Introduzca código de cliente de 6 dígitos " + ;
  99.                     "empezando por letra - Esc para salir"
  100.          @  3, 0 SAY "ARTICULO Nº:" GET mpartid FUNCTION "!"
  101.          @  4, 0 SAY "EMPLEADO Nº:" GET mempid
  102.          @  5, 0 SAY "Introduzca una o más condiciones"
  103.          READ
  104.      DEACTIVATE WINDOW alert
  105.      * Inicializar la variable de la condición de filtro
  106.      subset = " "
  107.      * Proceso de entradas para definir la condición de filtro
  108.      mCliid   = TRIM(mCliid)
  109.      mpartid   = TRIM(mpartid)
  110.      mempid    = TRIM(mempid)
  111.      subset =  subset + IIF("" <> mCliid,"Cód_cli = '&mCliid.' .AND. ","")
  112.      subset =  subset + IIF("" <> mpartid,"Cód_art = '&mpartid.' .AND. ","")
  113.      subset =  subset + IIF("" <> mempid, "Cód_emp = '&mempid.'  .AND. ","")
  114.      *
  115.      IF "" = TRIM(subset)      && Comprobar si se han introducido datos en la serie
  116.         * Si la serie está vacia, salir
  117.         DO Warnbell
  118.         filters_on = .F.
  119.      ELSE
  120.         * Si la serie no está vacia, truncar desde .AND. hasta el final
  121.         subset = SUBSTR(subset,1,LEN(subset)-6)
  122.         SET FILTER TO &subset.   && Activar el filtro con la serie introducida
  123.         GO TOP                   && Activar el filtro moviendo el puntero de registro
  124.         * Comprobar si algunos registros cumplen la condición de filtro (EOF=ninguno la cumple)
  125.         filters_on = .NOT. EOF()
  126.         IF .NOT. filters_on           && Desactivar el filtro si filters_on = .F.
  127.            DO Warnbell
  128.            DO Show_msg WITH "Ningún registro de Ordenes de Pedido      cumple la condición de filtro."
  129.            SET FILTER TO
  130.            GO record_num
  131.         ENDIF
  132.       ENDIF
  133.    ELSE
  134.       * Si se selecciona "D", desactivar el filtro
  135.       SET FILTER TO
  136.       filters_on = .F.
  137.    ENDIF
  138. RETURN
  139.  
  140. PROCEDURE Indexer
  141.    * Crear/reconstruir índices
  142.    INDEX ON Cód_cli+DTOC(Fech_trans)+Núm_ped TAG Pedido
  143.    GO TOP
  144. RETURN
  145.  
  146. PROCEDURE Init_fld
  147.    * Inicializar las variables de memoria para introducir datos
  148.    Cód_cli    = SPACE(6)
  149.    Fech_trans = DATE()
  150.    Núm_ped    = SPACE(5)
  151.    Cód_emp    = SPACE(11)
  152.    Cód_art    = SPACE(10)
  153.    Can_art    = 0
  154.    Facturado  = .F.
  155. RETURN
  156.  
  157. PROCEDURE Load_fld
  158.    * Cargar los valores de los campos del registro de PEDIDOS en variables de memoria
  159.    Cód_cli    = Cód_cli
  160.    Fech_trans = Fech_trans
  161.    Núm_ped    = Núm_ped
  162.    Cód_emp    = Cód_emp
  163.    Cód_art    = Cód_art
  164.    Can_art    = Can_art
  165.    Facturado  = Facturado
  166. RETURN
  167.  
  168. PROCEDURE Repl_fld
  169.    * Sustituir los campos del fichero con los valores de las variables
  170.    REPLACE Cód_cli WITH m->Cód_cli, Núm_ped WITH m->Núm_ped,;
  171.            Fech_trans WITH m->Fech_trans, Cód_emp WITH m->Cód_emp, ;
  172.            Cód_art WITH m->Cód_art, Can_art WITH m->Can_art, ;
  173.            Facturado  WITH m->Facturado
  174. RETURN
  175.  
  176. FUNCTION Prof_mgn
  177.    PARAMETERS Coste,Precio
  178.    * Calcular margen de beneficio
  179.    margin = ROUND((Precio-Coste)/Precio*100,1)
  180. RETURN margin
  181.  
  182. PROCEDURE Backgrnd
  183.    * Visualizar la pantalla para entrada de datos y visualizaciones
  184.    @  1,18 TO  3,49 DOUBLE COLOR &c_blue.
  185.    @  5, 2 TO  8,56 DOUBLE COLOR &c_red.
  186.    @ 16, 2 TO 16,56        COLOR &c_red.
  187.    @  9, 2 TO 18,56        COLOR &c_red.
  188.    @  2,19 FILL TO  2,48   COLOR &c_blue.
  189.    @  6, 3 FILL TO  7,55   COLOR &c_red.
  190.    @ 10, 3 FILL TO 17,55   COLOR &c_red.
  191.    @  6, 3 FILL TO 17,55   COLOR &c_red.
  192.    SET COLOR TO &c_data.
  193.    @  2,20 SAY "FICHERO DE ORDENES DE PEDIDO"
  194.    @  6, 4 SAY "CLIENTE Nº:"
  195.    @  7, 4 SAY "FECHA DE PEDIDO:"
  196.    @  7,35 SAY "PEDIDO Nº:"
  197.    @ 10, 4 SAY "ARTICULO Nº:"
  198.    @ 11, 4 SAY "NOMBRE ART.:"
  199.    @ 12, 4 SAY "CANT. PEDIDA:"
  200.    @ 12,25 SAY "unidad(es)"
  201.    @ 12,36 SAY "PRECIO:           ₧"
  202.    @ 13, 4 SAY "CANT. DISPONIBLE:"
  203.    @ 13,25 SAY "unidad(es)"
  204.    @ 13,36 SAY "MARGEN:           %"
  205.    @ 14, 4 SAY "EMPLEADO Nº:"
  206.    @ 15, 4 SAY "FACTURADO:"
  207.    @ 17, 4 SAY "NOTAS:"
  208.    SET COLOR TO &c_standard.
  209. RETURN
  210.  
  211. PROCEDURE Show_data
  212.    * Visualizar pantalla para entrada de datos
  213.    SET COLOR TO &c_fields.
  214.    @  6,16 SAY Cód_cli
  215.    @  7,21 SAY Fech_trans
  216.    @  7,46 SAY Núm_ped
  217.    @ 10,18 SAY Cód_art
  218.    @ 12,21 SAY Can_art   PICTURE "999"
  219.    @ 14,17 SAY Cód_emp
  220.    @ 15,15 SAY Facturado  PICTURE  "Y"
  221.    @ 17,11 SAY Notas
  222.    IF .NOT. BAR() = 2           && no modo de adición
  223.       @  6,25 SAY Cli->Cliente                          COLOR &c_yelowhit.
  224.       @ 11,18 SAY Artículo->Nom_art                     COLOR &c_yelowhit.
  225.       @ 12,44 SAY Artículo->Precio  PICTURE "9,999,999" COLOR &c_yelowhit.
  226.       @ 13,21 SAY Artículo->Can_alm PICTURE "999"       COLOR &c_yelowhit.
  227.       @ 13,49 SAY Prof_mgn(Artículo->Coste,Artículo->Precio) ;
  228.               PICTURE "99.9" COLOR &c_yelowhit.
  229.       @ 14,30 SAY TRIM(Empleado->Nombre)+" "+ Empleado->Apellido ;
  230.               COLOR &c_yelowhit.
  231.    ELSE
  232.       * Modo Adición borrar de pantalla las zonas de los campos
  233.       @  6,25 SAY SPACE(30)    && CLIENTE
  234.       @ 11,18 SAY SPACE(20)    && NOMBRE DE ARTICULO
  235.       @ 12,44 SAY SPACE(9)     && PRECIO
  236.       @ 13,21 SAY SPACE(3)     && CANTIDAD ALMACENADA
  237.       @ 13,49 SAY SPACE(4)     && MARGEN
  238.       @ 14,30 SAY SPACE(26)    && EMPLEADO
  239.    ENDIF
  240.    IF ISCOLOR()
  241.       @ 20, 2 SAY " Texto/números en amarillo son de fichero relacionado. " ;
  242.          COLOR &c_yelowhit.
  243.    ELSE
  244.       @ 20, 2 SAY " Texto/números sin resaltar son de fichero relacionado. "
  245.          COLOR &c_red.
  246.    ENDIF
  247.    SET COLOR TO &c_standard.
  248. RETURN
  249.  
  250. PROCEDURE Get_data
  251.    * Visualizar pantalla para entrada de datos
  252.    SET COLOR TO &c_data.
  253.    @  6,16 GET m->Cód_cli    PICTURE  "!99999" ;
  254.            VALID Lookupid(m->Cód_cli,"Cli","Cliente", 2) ;
  255.            ERROR "Número de cliente no válido. Por favor, introduzca de nuevo." ;
  256.            MESSAGE "Introduzca código de cliente de 6 dígitos " + ;
  257.                    "comenzando por una letra - Esc para salir"
  258.    @  7,21 GET m->Fech_trans FUNCTION "D" ;
  259.            MESSAGE "Introduzca la fecha de este pedido"
  260.    @  7,46 GET m->Núm_ped  FUNCTION "!" ;
  261.            MESSAGE "Introduzca el número de pedido"
  262.    @ 10,18 GET m->Cód_art    FUNCTION "!" ;
  263.            VALID Lookupid(m->Cód_art,"Artículo", "Part", 3) ;
  264.            ERROR "Número de pedido no válido. Por favor, introduzca de nuevo." ;
  265.            MESSAGE "Introduzca número de pédido - Esc para salir"
  266.    @ 12,21 GET m->Can_art   PICTURE "999" ;
  267.            MESSAGE "Introduzca cantidad pedida"
  268.    @ 14,17 GET m->Cód_emp PICTURE "999-99-9999" ;
  269.            VALID Lookupid(m->Cód_emp, "Empleado", "Empleado", 6) ;
  270.            ERROR "Número de empleado no válido. Por favor, introduzca de nuevo." ;
  271.            MESSAGE "Introduzca número de empleado - Esc para salir"
  272.    @ 15,15 GET m->Facturado  PICTURE  "Y" ;
  273.            MESSAGE "Introduzca si este pedido ha sido Facturado " + ;
  274.                    "(normalmente realizado por el sistema)"
  275.    @ 17,11 GET Notas WINDOW memo_windo ;
  276.            MESSAGE "Introduzca las notas en el campo memo, pulse " + ;
  277.                    "Ctrl-Home para acceder (Ctrl-End para salir)"
  278.    IF .NOT. BAR() = 2           && Modo no adicción
  279.       @  6,25 SAY Cli->Cliente                          COLOR &c_yelowhit.
  280.       @ 11,18 SAY Artículo->Nom_art                     COLOR &c_yelowhit.
  281.       @ 12,44 SAY Artículo->Precio  PICTURE "9,999,999" COLOR &c_yelowhit.
  282.       @ 13,21 SAY Artículo->Can_alm PICTURE "999"       COLOR &c_yelowhit.
  283.       @ 13,49 SAY Prof_mgn(Artículo->Coste,Artículo->Precio) ;
  284.               PICTURE "99.9" COLOR &c_yelowhit.
  285.       @ 14,30 SAY TRIM(Empleado->Nombre)+" "+ Empleado->Apellido ;
  286.               COLOR &c_yelowhit.
  287.    ELSE
  288.       * Modo Adición borrar de pantalla las zonas de los campos
  289.       @  6,26 SAY SPACE(30)    && CLIENTE
  290.       @ 11,18 SAY SPACE(20)    && NOMBRE DE ARTICULO
  291.       @ 12,44 SAY SPACE(9)     && PRECIO
  292.       @ 13,21 SAY SPACE(3)     && CANTIDAD ALMACENADA
  293.       @ 13,48 SAY SPACE(4)     && MARGEN DE BENEFICIOS
  294.       @ 14,30 SAY SPACE(26)    && EMPLEADO
  295.    ENDIF
  296.    IF ISCOLOR()
  297.       @ 20, 2 SAY " Texto/números en amarillo son de fichero relacionado. " ;
  298.          COLOR &c_yelowhit.
  299.    ELSE
  300.       @ 20, 2 SAY " Texto/números sin resaltar son de fichero relacionado. " ;
  301.          COLOR &c_red.
  302.    ENDIF
  303.    SET COLOR TO &c_standard.
  304.    ON KEY LABEL F9 DO FindCli WITH m->Cód_cli
  305.    ON KEY LABEL F10 DO Findpart WITH m->Cód_art
  306. RETURN
  307. ************************************** FIN DE PEDIDOS.PRG ********************************
  308.